perm filename PARTS.F4[MSS,LCS]2 blob
sn#134996 filedate 1974-12-12 generic text, type T, neo UTF8
00100 C THIS AIDS IN EXTRACTING PARTS FROM SCORES.
00200 COMMON PWDS(250),RN(2000)
00300 1,LP,TR,XWDS(250),XN(2000)
00350 DIMENSION ST(8)
00400
00500 12 TYPE 1
00600 REWIND 21
00700 ACCEPT 2,N
00710 IF(N.NE.'HELP')GO TO 13
00720 TYPE 14
00730 GO TO 12
00740 14 FORMAT(' FOR "WHICH STAFF#?" GIVE N1, N2, N3'/'
00750 1 N2=TRANSP. STEPS, N3=1=WILL BE SAME FOR ALL FILES'/)
00800 13 CALL OFILE(21,N)
00900 XWDS(1)=1
01000 RM=0
01100 CC RS=4
01200 L=1
01300 CC LK=1
01400 LP=1
01500 TYPE 44
01600 ACCEPT 5,RS
01700 10 TYPE 3
01710 LK=LP
01800 REWIND 22
01900 ACCEPT 2,NM
02000 IF(NM.EQ.' ')GO TO 20
02100 CALL IFILE(22,NM)
02110 JZ=0
02200 IF(RM.NE.0)GO TO 30
02300 TYPE 4
02400 ACCEPT 5,SN,TR,RM
02500 C TYPE 2ND NUM FOR TRANSPOSE, 3RD NUM FOR ALWAYS SAME STFF.
02550 30 J=1
02600 READ(22),ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1)
02650 1,J,J,J,J,RS,ST,K
02700 CC IF(L+ITEM.LE.250.AND.LP+I.LE.2000)GO TO 8
02800 8 DO 6 K=1,ITEM
02900 J=PWDS(K)
03000 IF(RN(J+1).NE.4)GO TO 80
03100 IF(RN(J).NE.2)GO TO 80
03200 C FOUND A BAR LINE
03300 RN(J+4)=1
03310 KC=RN(J+2)*10
03320 DO 82 KA=K+1,ITEM
03330 KB=PWDS(KA)
03340 IF(RN(KB+1).NE.4.OR.RN(KB).NE.2)GO TO 82
03350 C AVOIDS DUPLICATE BARS.
03360 KD=RN(KB+2)*10
03370 IF(KC.EQ.KB)RN(KB+1)=0
03380 82 CONTINUE
03400 GO TO 81
03500 80 IF(RN(J+3).NE.SN)GO TO 6
03510 JZ=-1
03600 81 JA=PWDS(K+1)
03700 DO 7 KA=J,JA-1
03800 XN(LK)=RN(KA)
03900 7 LK=LK+1
03910 IF(L.LT.250.AND.LK.LE.2000)GO TO 50
03932 TYPE 9
03954 GO TO 20
03976 16 FORMAT(' STAFF NOT FOUND'/)
04000 50 R=XN(LP+1)
04100 IF(TR.NE.0.AND.(R.EQ.1.OR.R.EQ.8.OR.R.EQ.9))CALL TRANSP
04200 XN(LP+3)=RS
04600 L=L+1
04700 LP=LK
04800 XWDS(L)=LP
04900 6 CONTINUE
04910 IF(JZ)GO TO 17
04920 L=JX
04930 LP=JY
04940 TYPE 16
04950 GO TO 10
04960 17 JX=L
04970 JY=LP
05000 RS=RS-1
05100 IF(RS.GT.-4)GO TO 10
05200 20 L=JX-1
05300 J=1
05400 WRITE(21),L,JY,
05500 1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J,RS,ST,K,K
05600 15 END FILE 21
05700 1 FORMAT(' TYPE OUTPUT FILE NAME'/)
05800 2 FORMAT(A5)
05900 3 FORMAT(' TYPE FILE NAME'/)
06000 4 FORMAT(' WHICH STAFF # ?'/)
06100 5 FORMAT(5F)
06200 9 FORMAT(' NO ROOM FOR THIS ONE')
06300 44 FORMAT(' TYPE TOP STAFF #'/)
06400 END
06500
06600 SUBROUTINE TRANSP
06700 COMMON PWDS(250),RN(2000)
06800 1,LP,TR,XWDS(250),XN(2000)
06900 A=XN(LP+4)
07000 XN(LP+4)=A+TR
07100 C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
07110 X=XN(LP+5)
07200 IF(XN(LP+1).EQ.1)GO TO 11
07210 XN(LP+5)=X+TR
07300 RETURN
07310 11 IF(AMOD(TR+16.0,8.0).NE.2)RETURN
07320 C NEXT IS FOR Bb TRANSP.
07330 B=AMOD(A+7.0,7.0)
07340 IF(B.NE.0.AND.B.NE.3)RETURN
07350 C FINDS ORIG. E OR B
07360 K=AMOD(X,10.0)
07370 C FINDS ACCID.
07380 X=X-K
07390 C STEM DIR. AND DECI.
07395 B=0
07400 IF(K.EQ.0.OR.K.EQ.3)B=2
07410 C NO PROVISION YET FOR ## OR bb
07420 XN(LP+5)=X+B
07430 RETURN
07440 END